home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 11 / Cream of the Crop 11-1.iso / comm / tcp4w15.zip / PWLPQ.PAS < prev    next >
Pascal/Delphi Source File  |  1995-06-08  |  5KB  |  206 lines

  1. Program PWTN;
  2. {$A+,B-,D+,F-,G+,I-,K+,L+,N-,P+,Q+,R+,S+,T+,V+,W+,X+,Y+}
  3. {$M 8192,8192}
  4. {Simple LPQ (Line Printer Queue) Client for TCP4W}
  5. {See RFC 1179 for LPQ-Definitions}
  6.  
  7. Uses WinTypes, WinProcs, WinCrt, Strings, UseTcp4w;
  8.  
  9. Const TIL = 255;
  10.  
  11. Type PTextItem = ^TTextItem;
  12.      TTextItem = Array [0..TIL] of Char;
  13.  
  14. Var Status: Integer;
  15.     S: TSocket;
  16.     Port: Integer;
  17.     H: String;
  18.     PrinterIP: Array [0..80] Of Char;
  19.     T: TTextItem;
  20.     IP: TIP;
  21.     F: File;
  22.     SaveExitProc: Pointer;
  23.  
  24. Procedure WriteWinsockVerInfo;
  25.   Const WSADESCRIPTION_LEN = 256;
  26.         WSASYS_STATUS_LEN = 128;
  27.   Type TWSAData = Record
  28.            wVersion: Word;
  29.            wHighVersion: Word;
  30.            szDescription: Array [0..WSADESCRIPTION_LEN] Of Char;
  31.            szSystemStatus: Array [0..WSASYS_STATUS_LEN] Of Char;
  32.            iMaxSockets: Byte;
  33.            iMaxUdpDg: Byte;
  34.            lpVendorInfo: Pointer;
  35.          End;
  36.        TWSAStartUp = Function (wVersionRequested: Word; WSAData: TWSAData): Integer;
  37.        TWSACleanup = Function: Integer;
  38.   Var WSAData: TWSAData;
  39.       hWinsock: THandle;
  40.       FP : TFarProc;
  41.   Begin
  42.     hWinsock := LoadLibrary ('WINSOCK');
  43.     If hWinsock >= 32 Then
  44.       Begin
  45.         FP := GetProcAddress (hWinsock, 'WSAStartup');
  46.         If FP <> NIL Then
  47.           If TWSAStartUp (FP) (257, WSAData) = 0 Then
  48.             WriteLn (WSAData.szDescription);
  49.         FP := GetProcAddress (hWinsock, 'WSACleanup');
  50.         If FP <> NIL Then TWSACleanUp (FP);
  51.         FreeLibrary (hWinsock)
  52.       End
  53.   End;
  54.  
  55. Procedure CheckIO;
  56.   Begin
  57.     If IOResult = 0 Then Exit;
  58.     WriteLn;
  59.     WriteLn ('File-Error.');
  60.     Halt
  61.   End;
  62.  
  63. Procedure CheckStatus;
  64.   Begin
  65.     If Status > 0 Then Exit;
  66.     WriteLn;
  67.     WriteLn ('?', Tcp4W_Error (Status));
  68.     Halt
  69.   End;
  70.  
  71. Procedure PrinterAnswer;
  72.   Var I: Word;
  73.   Begin
  74.     Status := TcpRecv (S, T, TIL, 10, -1);
  75.     If Status > 0 Then T[Status] := #0;
  76.     If (Status = IP_EmptyBuffer) Then Exit;
  77.     CheckStatus;
  78.     If StrLen (T) > 0 Then
  79.       Begin
  80.         WriteLn;
  81.         WriteLn ('Printer-Error.');
  82.         Halt
  83.       End;
  84.   End;
  85.  
  86. Procedure TypeFile;
  87.   Var L: LongInt;
  88.   Begin
  89.     L := FileSize (F);
  90.     While L > TIL Do
  91.       Begin
  92.         BlockRead (F, T, TIL);
  93.         CheckIO;
  94.         Status := TCPSend (S, T, TIL, False, -1);
  95.         CheckStatus;
  96.         L := L - TIL;
  97.         Write ('.');
  98.       End;
  99.     If L = 0 Then Exit;
  100.     BlockRead (F, T, L);
  101.     CheckIO;
  102.     Status := TCPSend (S, T, L, False, -1);
  103.     CheckStatus
  104.   End;
  105.  
  106. Procedure MyExitProc; Far;
  107.   Begin
  108.     ExitProc := SaveExitProc;
  109.     If S <> 0 Then TcpClose (S);
  110.     Tcp4wCleanUp;
  111.   End;
  112.  
  113. Begin
  114.   CmdShow := sw_ShowMaximized;
  115.   AutoTracking := False;
  116.   WriteLn ('Simple lpq Client by AStA (Andreas.Tikart@uni-konstanz.de) <Polarwolf>');
  117.  
  118.   S := 0;
  119.   Port := 515;
  120.   Status := Tcp4wInit;
  121.   CheckStatus;
  122.   SaveExitProc := ExitProc;
  123.   ExitProc := @MyExitProc;
  124.  
  125.   Tcp4wVer (T, TIL);
  126.   WriteLn (T);
  127.   WriteWinsockVerInfo;
  128.  
  129.   WriteLn;
  130.   Write ('Printer-IP:');
  131.   ReadLn (PrinterIP);
  132.   If StrLen (PrinterIP) = 0 Then Halt;
  133.  
  134.   Status := TcpConnect (S, PrinterIP, '', Port);
  135.   CheckStatus;
  136.   WriteLn ('Socket: ', S, '  Port: ', Port);
  137.   Status := TcpGetRemoteID (S, T, TIL, IP);
  138.   CheckStatus;
  139.   WriteLn ('Remote Printer: ', T, ' (', IP.B1, '.', IP.B2, '.',
  140.     IP.B3, '.', IP.B4, ')');
  141.  
  142.   StrPCopy (T, #2'AStA'#10);
  143.   Status := TCPSend (S, T, StrLen (T), False, -1);
  144.   CheckStatus;
  145.   PrinterAnswer;
  146.  
  147.   StrPCopy (T, #2'2 cfA004'#10);
  148.   Status := TCPSend (S, T, StrLen (T), False, -1);
  149.   CheckStatus;
  150.   PrinterAnswer;
  151.  
  152.   StrPCopy (T, 'o'#10#0);
  153.   Status := TCPSend (S, T, StrLen (T)+1, False, -1);
  154.   CheckStatus;
  155.   PrinterAnswer;
  156.  
  157.   TcpClose (S);
  158.   S := 0;
  159.   CheckStatus;
  160.  
  161.   Status := TcpConnect (S, PrinterIP, '', Port);
  162.   CheckStatus;
  163.  
  164.   StrPCopy (T, #2'AStA'#10);
  165.   Status := TCPSend (S, T, StrLen (T), False, -1);
  166.   PrinterAnswer;
  167.  
  168.   WriteLn;
  169.   Write ('Postscipt-Filename:');
  170.   ReadLn (H);
  171.   If Length (H) = 0 Then Halt;
  172.   Assign (F, H);
  173.   Reset (F, 1);
  174.   CheckIO;
  175.   Str (FileSize (F), H);
  176.   CheckIO;
  177.   If H [1] = ' ' Then H := Copy (H, 2, 255);
  178.   StrPCopy (T, #3+H+' dfA004'#10);
  179.   Status := TCPSend (S, T, StrLen (T), False, -1);
  180.   CheckStatus;
  181.   TypeFile;
  182.   StrPCopy (T, #0);
  183.   Status := TCPSend (S, T, 1, False, -1);
  184.   CheckStatus;
  185.   PrinterAnswer;
  186.  
  187.   Close (F);
  188.   CheckIO;
  189.   TcpClose (S);
  190.   S := 0;
  191.   CheckStatus;
  192.  
  193.   Status := TcpConnect (S, PrinterIP, '', Port);
  194.   CheckStatus;
  195.  
  196.   StrPCopy (T, #1'AStA'#10#0);
  197.   Status := TCPSend (S, T, StrLen (T)+1, False, -1);
  198.   PrinterAnswer;
  199.   TcpClose (S);
  200.   S := 0;
  201.   CheckStatus;
  202.  
  203.   WriteLn;
  204.   WriteLn ('OK');
  205. End.
  206.